home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / program / commio0b.zip / _EXIT.PAS next >
Pascal/Delphi Source File  |  1996-05-14  |  6KB  |  146 lines
  1. unit _exit;
  2. {
  3.           This unit is a companion to the COMMIO communications unit.
  4.                 Written by Jason Morriss a.k.a. Lief O'Pardy
  5.  
  6.                   Copyright (C) 1995,1996 by Jason Morriss
  7.  
  8.  
  9.  This unit should be placed before ALL other unitnames in the "uses" statment
  10.  in your main program source.  This assures that the New Handlers below are
  11.  Installed before anything else.  But if you have a unit that must go before
  12.  this one than thats ok, but if that unit allocates any memory in its "init"
  13.  section, it cannot rely on the memory handler that this unit creates.
  14.  
  15. This unit will do the following:
  16.   Θ Installs a new exit procedure.  If your program is halted by some sort of
  17.     internal error (ie: IO error, etc) this will bypass the TP [ugly] exit
  18.     procedure and display a better discription of the error.  This just looks
  19.     much more professional then TP's "runtime error: blabla".
  20.   Θ Saves and restores the HEAP marker automatically.  This means that you
  21.     don't have to use dispose or freemem before your program exits, because
  22.     this will free the entire heap that was used, and you don't have to do a
  23.     thing! ***(this is the main reason why this unit should go before anything
  24.     else.  If you have a unit before this, and that unit uses some of the heap
  25.     this unit will not know about it, and will not be able to restore the heap
  26.     it used)
  27.     this feature might be useless.  i think tp does this automatically... but
  28.     i'm not sure...
  29.   Θ Installs a new memory handler.  If you try to allocate a chunk of memory
  30.     to something and there's not enough heap, instead of halting with an
  31.     out of memory error like TP does, this will continue normally with the
  32.     program, but the variable that you tried to assign the memory to, will
  33.     have the value NIL.  This makes it easier to do error checks when
  34.     allocating memory.  You use it like this:
  35.      getmem(myptr,myptrsize);
  36.      if myptr=nil then <not enough memory>
  37.      ..
  38.      if myptr<>nil then freemem(myptr,myptrsize);
  39.  
  40.   *NOTE* everything is handled AUTOMATICALLY by this unit, you don't have to
  41.          do ANYTHING for the handlers, etc... enjoy.
  42. }
  43. interface
  44.  
  45. const
  46.   MAX_ExitProcs = 256;
  47.  
  48. type
  49.   TExitProc = procedure;
  50.   TProcAry  = array[1..Max_ExitProcs] of TExitProc; {ary=1024 bytes}
  51.  
  52. Function AddtoExitChain(proc:TExitProc):boolean;
  53. {^ This adds a procedure to the "Exit Chain".  Any procedures in the Exit
  54.    Chain are called when your program ends, automatically... No matter how
  55.    the program gets terminated (normally, HALT(), ^C).  (unless something
  56.    drastic happens, and the whole system gets fucked because of it ;)
  57.      proc = procedure to add.  The procedure cannot have any parameters,
  58.             and MUST be compiled FAR. And to be safe, the location of the
  59.             procedure should not be an Overlayed unit. (i'm not sure what
  60.             would happen though; probably nothing)
  61.  
  62.    The procedures are called in a "LIFO" (last in, first out) fasion.  This
  63.    is so that the Comport routines will be the very last thing to DeInit
  64.    itself.  For 2 reasons.  1) So you don't have to worry about Calling
  65.    "DeInitComport" at the end of your program.  COMMIO adds its own procedure
  66.    to the ExitChain, to DeInit itself for you. (and its always the very
  67.    first procedure in the chain)  2) Since COMMIO is last to be "shut down",
  68.    any of your procedures in the Exit Chain can use the comport still, if
  69.    you need/want to. (as long as you don't call DeInitComport yourself!)
  70.  
  71.    NOTE: once you add a procedure, you cannot remove it. (this could be
  72.    changed easily, but i have no need to remove procedures [yet], so i
  73.    don't feel like adding the code for it, sorry; live with it)
  74. }
  75.  
  76. Implementation
  77.  
  78. type
  79.   string10 = string[10];
  80.  
  81. const
  82.   ChainNum : integer = 0;
  83. var
  84.   ExitChain : TProcAry;
  85.   SavedExitProc:pointer;
  86.   hp:pointer;
  87.  
  88. const
  89.   hx : array[0..15] of char='0123456789ABCDEF'; {needed for the Hex() funcs}
  90.  
  91. {───────────────────────────────────────────────────────────────────────────}
  92. Function AddtoExitChain;
  93. begin
  94.   AddtoExitChain:=false;
  95.   if (ChainNum<MAX_ExitProcs)and(@proc<>nil) then begin
  96.     inc(ChainNum);
  97.     ExitChain[ChainNum]:=proc;
  98.     AddtoExitChain:=true;
  99.   end;
  100. end;
  101. {───────────────────────────────────────────────────────────────────────────}
  102. function hex2(b:byte):string10;
  103. begin
  104.   hex2 := hx[(b shr 4) and 15]+hx[b and 15];
  105. end;
  106. {───────────────────────────────────────────────────────────────────────────}
  107. function hex4(w:word):string10;
  108. begin
  109.   hex4 := hex2(hi(w))+hex2(lo(w));
  110. end;
  111. {───────────────────────────────────────────────────────────────────────────}
  112. Function CustomHeapError(Size : word) : integer; far; {MUST BE FAR}
  113. begin
  114.   CustomHeapError := 1;   {forces New & Getmem to return NIL}
  115. end;
  116. {───────────────────────────────────────────────────────────────────────────}
  117. Procedure CustomExit; far; {MUST BE FAR}
  118. var i:integer;
  119. begin
  120.   if ErrorAddr<>nil then begin
  121.     asm mov ax,3; int 10h end;        { make sure we go back to text mode }
  122.     writeln('■ An unknown error has occured. -Program halted');
  123.     writeln('   Address  = ',hex4(seg(erroraddr^)),'h:',hex4(ofs(erroraddr^)),'h');
  124.     writeln('   ExitCode = ',ExitCode);
  125.     reset(input);
  126.     ErrorAddr:=nil;                {This is so TP will not display its error}
  127.     ExitCode:=0;                   { message.}
  128.   end;
  129.  
  130.   for i := ChainNum downto 1 do
  131.     if @ExitChain[i]<>nil then ExitChain[i];
  132.  
  133.   release(hp);                                 { release all remaining heap }
  134.   ExitProc:=SavedExitProc;           { This should be done so the TP's exit
  135.                                       procedure (and any others that might be
  136.                                       installed from other units) can take
  137.                                       over after this one. }
  138. end;
  139. {───────────────────────────────────────────────────────────────────────────}
  140.  
  141. begin
  142.   SavedExitProc := ExitProc;
  143.   ExitProc := @CustomExit;
  144.   HeapError := @CustomHeapError;
  145.   mark(hp); { get current heap amount }
  146. end.